## Loading the packages and data
library(dispRity)
load(file = "../Data/Processed/trees_list.rda")
load(file = "../Data/Processed/spaces_list.rda")
The basic idea is to measure the elaboration as the projection of observations (species) on a base vector (e.g. a1 the projection of a on b) and the exploration as the rejection from the base vector (e.g. a2 the rejection of a from b). Each observation can then be described in 2D with a elaboration score (the higher the absolute value of the score, the more the species is an elaborator - in both directions of b) and a exploration score (the higher, the more they explore). Of course we do that in any number of dimensions (not just 2!) and we’re going to play with the meaning of vector b (the base vector).
We can play around with it with these two spaces by defining a vector that is spanning from the 25%th quantile to the 75% quantile of all data (the 50% “average”ish axis).
## Getting the base vectors for both groups
psita_vector <- apply(spaces_list$psittaciformes, 2, quantile, prob = c(0.025, 0.975))
chara_vector <- apply(spaces_list$charadriiformes, 2, quantile, prob = c(0.025, 0.975))
## Calculating the projections/rejections for both groups
psita_proj <- projections(spaces_list$psittaciformes, point1 = psita_vector[1,], point2 = psita_vector[2, ])
psita_reje <- projections(spaces_list$psittaciformes, point1 = psita_vector[1,], point2 = psita_vector[2, ], measure = "distance")
chara_proj <- projections(spaces_list$charadriiformes, point1 = chara_vector[1,], point2 = chara_vector[2, ])
chara_reje <- projections(spaces_list$charadriiformes, point1 = chara_vector[1,], point2 = chara_vector[2, ], measure = "distance")
## A function for identifying and plotting the top explorer/elaborators names (for checking)
identify.tops <- function(scores, data, prob = 0.99, plot = FALSE, ...) {
## Get the tops
tops <- which(scores >= quantile(scores, prob = prob))
## Get their names
top_names <- rownames(data)[tops]
if(plot) {
text(data[tops,], labels = top_names, ...)
}
return(top_names)
}
par(mfrow = c(3, 2))
plot(spaces_list$psittaciformes[, 1:2], col = "blue", main = "Psittaciformes section of the shape space", xlab = "PC1 (unscaled)", ylab = "PC2 (unscaled)", pch = 19)
arrows(x0 = psita_vector[1,1], y0 = psita_vector[1,2],
x1 = psita_vector[2,1], y1 = psita_vector[2,2], col = "black", lwd = 4)
plot(spaces_list$charadriiformes[, 1:2], col = "orange", main = "Psittaciformes section of the shape space", xlab = "PC1 (unscaled)", ylab = "PC2 (unscaled)", pch = 19)
arrows(x0 = chara_vector[1,1], y0 = chara_vector[1,2],
x1 = chara_vector[2,1], y1 = chara_vector[2,2], col = "black", lwd = 4)
## The elaboration/exploration profiles
plot(psita_proj, psita_reje, pch = 19, col = "blue",
xlab = "Elaboration", ylab = "Exploration", main = "Psittaciformes explo/elaboration profile")
plot(chara_proj, chara_reje, pch = 19, col = "orange",
xlab = "Elaboration", ylab = "Exploration", main = "Charadriiformes explo/elaboration profile")
## The elaboration/exploration profiles
plot(abs(psita_proj), psita_reje, pch = 19, col = "blue",
xlab = "Elaboration (absolute)", ylab = "Exploration", main = "Psittaciformes explo/elaboration profile")
plot(abs(chara_proj), chara_reje, pch = 19, col = "orange",
xlab = "Elaboration (absolute)", ylab = "Exploration", main = "Charadriiformes explo/elaboration profile")
## Making a top table
psita_tops_proj <- identify.tops(score = abs(psita_proj), data = spaces_list$psittaciformes)
psita_tops_reje <- identify.tops(score = psita_reje, data = spaces_list$psittaciformes)
chara_tops_proj <- identify.tops(score = abs(chara_proj), data = spaces_list$charadriiformes)
chara_tops_reje <- identify.tops(score = chara_reje, data = spaces_list$charadriiformes)
## Making a top table
psita_top_proj <- identify.tops(score = abs(psita_proj), data = spaces_list$psittaciformes, prob = 1)
psita_top_reje <- identify.tops(score = psita_reje, data = spaces_list$psittaciformes, prob = 1)
chara_top_proj <- identify.tops(score = abs(chara_proj), data = spaces_list$charadriiformes, prob = 1)
chara_top_reje <- identify.tops(score = chara_reje, data = spaces_list$charadriiformes, prob = 1)
The top 99% elaborators are:
parrots: Cacatua_tenuirostris, Nestor_meridionalis, Nestor_notabilis, Probosciger_aterrimus
sea gulls: Gallinago_hardwickii, Gallinago_nemoricola, Gallinago_undulata, Limnodromus_semipalmatus
The top 99% explorers are:
parrots: Anodorhynchus_leari, Enicognathus_leptorhynchus, Micropsitta_pusio, Nestor_notabilis
sea gulls: Eurynorhynchus_pygmeus, Fratercula_arctica, Fratercula_cirrhata, Fratercula_corniculata
With our tops for each category:
Does this kind of works? Also this is nothing major, different or special compared to just picking species based on PC scores. The minor bonus here are:
I guess the key thing is determining the exploration/elaboration vector. We can add some evo perspective to all of these by making the base vector “evolutionary” and by looking at elaboration/exploration through time!
## Loading the whole shape space
shapespace <- readRDS("../Data/Raw/Beak_data/2020_08_07_MMB_MORPHO_SHAPESPACE_FULL.rds")$PCscores
## Getting the vector from that space
space_vector <- apply(shapespace, 2, quantile, prob = c(0.025, 0.975))
psita_space_proj <- projections(spaces_list$psittaciformes, point1 = space_vector[1,], point2 = space_vector[2, ])
psita_space_reje <- projections(spaces_list$psittaciformes, point1 = space_vector[1,], point2 = space_vector[2, ], measure = "distance")
chara_space_proj <- projections(spaces_list$charadriiformes, point1 = space_vector[1,], point2 = space_vector[2, ])
chara_space_reje <- projections(spaces_list$charadriiformes, point1 = space_vector[1,], point2 = space_vector[2, ], measure = "distance")
## Groups
group <- list("Psittaciformes" = trees_list$psittaciformes[[1]]$tip.label,
"Charadriiformes" = trees_list$charadriiformes[[1]]$tip.label,
"Others" = rownames(shapespace)[!(rownames(shapespace) %in% c(trees_list$psittaciformes[[1]]$tip.label, trees_list$charadriiformes[[1]]$tip.label))])
## Full space plot
plot(custom.subsets(shapespace, group = group), col = c("blue", "orange", "grey"), pch = c(19, 19, 21), main = "Bird beak shape space")
arrows(x0 = space_vector[1,1], y0 = space_vector[1,2],
x1 = space_vector[2,1], y1 = space_vector[2,2], col = "black", lwd = 4)
par(mfrow = c(2, 2))
## The elaboration/exploration profiles
plot(psita_space_proj, psita_space_reje, pch = 19, col = "blue",
xlab = "Elaboration", ylab = "Exploration", main = "Psitta explo/elaboration profile (total)")
plot(chara_space_proj, chara_space_reje, pch = 19, col = "orange",
xlab = "Elaboration", ylab = "Exploration", main = "Chara explo/elaboration profile (total)")
## The elaboration/exploration profiles
plot(abs(psita_space_proj), psita_space_reje, pch = 19, col = "blue",
xlab = "Elaboration (absolute)", ylab = "Exploration", main = "Psitta explo/elaboration profile (total)")
plot(abs(chara_space_proj), chara_space_reje, pch = 19, col = "orange",
xlab = "Elaboration (absolute)", ylab = "Exploration", main = "Chara explo/elaboration profile (total)")
Meh… But we can also do ratios: the one between the within group elaboration/exploration and the total elaboration/exploration. This can help us find the big time explorers/elaborators? (here: the one in the top 99% CI)
## Get the ratio
reje_ratio <- psita_reje/psita_space_reje
proj_ratio <- abs(psita_proj)/abs(psita_space_proj)
## Find the 99% top explorers/elaborators
top_explo <- which(reje_ratio >= quantile(reje_ratio, prob = 0.99))
top_elab <- which(proj_ratio >= quantile(proj_ratio, prob = 0.99))
top_explo_names <- rownames(spaces_list$psittaciformes)[top_explo]
top_elab_names <- rownames(spaces_list$psittaciformes)[top_elab]
plot(proj_ratio, reje_ratio, pch = 19, col = "blue",
xlab = "Group/space elaboration", ylab = "Group/space exploration", main = "Psittaciformes")
text(cbind(proj_ratio, reje_ratio)[top_explo, ], labels = top_explo_names, pos = 4)
text(cbind(proj_ratio, reje_ratio)[top_elab, ], labels = top_elab_names, pos = 1)
## Get the ratio
reje_ratio <- chara_reje/chara_space_reje
proj_ratio <- abs(chara_proj)/abs(chara_space_proj)
## Find the 99% top explorers/elaborators
top_explo <- which(reje_ratio >= quantile(reje_ratio, prob = 0.99))
top_elab <- which(proj_ratio >= quantile(proj_ratio, prob = 0.99))
top_explo_names <- rownames(spaces_list$charadriiformes)[top_explo]
top_elab_names <- rownames(spaces_list$charadriiformes)[top_elab]
plot(proj_ratio, reje_ratio, pch = 19, col = "orange",
xlab = "Group/space elaboration", ylab = "Group/space exploration", main = "Charadriiformes")
text(cbind(proj_ratio, reje_ratio)[top_explo, ], labels = top_explo_names, pos = 4)
text(cbind(proj_ratio, reje_ratio)[top_elab, ], labels = top_elab_names, pos = 1)
Maybe it’s picking up some weird birds…